home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 1
/
Cream of the Crop 1.iso
/
PROGRAM
/
TPL60N14.ARJ
/
HEAPTEST.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-05-01
|
4KB
|
128 lines
PROGRAM HeapTest; { Copyright (c) 1991,92 Norbert Juffa }
{$A+,B-,D+,E-,F-,G-,I+,L+,N-,O-,R-,S-,V-,X-}
{$M 4096,0,655360}
USES Time;
VAR Dummy,Start, LoopTime,LoopTime2: LONGINT;
L,Choice,K,T: WORD;
BlkPtr: ARRAY [1..1000] OF POINTER;
BlkSize: ARRAY [1..1000] OF WORD;
Permutation: ARRAY [1..1000] OF WORD;
BEGIN
RandSeed := 997;
WriteLn ('MaxAvail: ', MaxAvail, ' MemAvail: ', MemAvail);
Start := Clock;
FOR L := 1 TO 1000 DO BEGIN
END;
LoopTime := Clock-Start;
FOR L := 1 TO 1000 DO BEGIN
BlkSize [L] := Random (512) + 1;
END;
Write ('Allocating 1000 blocks at the end of the heap: ');
Start := Clock;
FOR L := 1 TO 1000 DO BEGIN
GetMem (BlkPtr [L], BlkSize [L]);
END;
WriteLn (Clock-Start-LoopTime:4, ' ms');
WriteLn ('MaxAvail: ', MaxAvail, ' MemAvail: ', MemAvail);
Write ('Deallocating same 1000 blocks in reverse order:');
Start := Clock;
FOR L := 1 TO 1000 DO BEGIN
FreeMem (BlkPtr [L], BlkSize [L]);
END;
WriteLn (Clock-Start-LoopTime:4, ' ms');
WriteLn ('MaxAvail: ', MaxAvail, ' MemAvail: ', MemAvail);
Write ('Allocating 1000 blocks at the end of the heap: ');
Start := Clock;
FOR L := 1 TO 1000 DO BEGIN
GetMem (BlkPtr [L], BlkSize [L]);
END;
WriteLn (Clock-Start-LoopTime:4, ' ms');
WriteLn ('MaxAvail: ', MaxAvail, ' MemAvail: ', MemAvail);
FOR L := 1 TO 1000 DO BEGIN
Permutation [L] := L;
END;
Start := Clock;
FOR L := 1000 DOWNTO 1 DO BEGIN
Choice := Random (L)+1;
K := Permutation [Choice];
Permutation [Choice] := Permutation [L];
END;
LoopTime2 := Clock - Start;
FOR L := 1 TO 1000 DO BEGIN
Permutation [L] := L;
END;
Write ('Deallocating same 1000 blocks at random: ');
Start := Clock;
FOR L := 1000 DOWNTO 1 DO BEGIN
Choice := Random (L)+1;
K := Permutation [Choice];
Permutation [Choice] := Permutation [L];
FreeMem (BlkPtr [K], BlkSize [K]);
END;
WriteLn (Clock-Start-LoopTime2:4, ' ms');
WriteLn ('MaxAvail: ', MaxAvail, ' MemAvail: ', MemAvail);
Write ('Allocating 1000 blocks at the end of the heap: ');
Start := Clock;
FOR L := 1 TO 1000 DO BEGIN
GetMem (BlkPtr [L], BlkSize [L]);
END;
WriteLn (Clock-Start-LoopTime:4, ' ms');
WriteLn ('MaxAvail: ', MaxAvail, ' MemAvail: ', MemAvail);
FOR L := 1 TO 1000 DO BEGIN
Permutation [L] := L;
END;
Start := Clock;
FOR L := 1000 DOWNTO 1 DO BEGIN
Choice := Random (L)+1;
K := Permutation [Choice];
T:= Permutation [L];
Permutation [L] := Permutation [Choice];
Permutation [Choice] := T;
END;
LoopTime2 := Clock - Start;
FOR L := 1 TO 1000 DO BEGIN
Permutation [L] := L;
END;
Write ('Deallocating 500 blocks at random: ');
Start := Clock;
FOR L := 1000 DOWNTO 501 DO BEGIN
Choice := Random (L)+1;
K := Permutation [Choice];
T:= Permutation [L];
Permutation [L] := Permutation [Choice];
Permutation [Choice] := T;
SYSTEM.FreeMem (BlkPtr [K], BlkSize [K]);
END;
WriteLn (Clock-Start-LoopTime2:4, ' ms');
WriteLn ('MaxAvail: ', MaxAvail, ' MemAvail: ', MemAvail);
Start := Clock;
FOR L := 1 TO 1000 DO BEGIN
Dummy := MaxAvail;
END;
WriteLn ('1000 calls to MaxAvail: ', Clock-Start, ' ms');
Start := Clock;
FOR L := 1 TO 1000 DO BEGIN
Dummy := MemAvail;
END;
WriteLn ('1000 calls to MemAvail: ', Clock-Start, ' ms');
WriteLn ('MaxAvail: ', MaxAvail, ' MemAvail: ', MemAvail);
Write ('Reallocating deallocated 500 blocks at random: ');
Start := Clock;
FOR L := 501 TO 1000 DO BEGIN
GetMem (BlkPtr [Permutation [L]], BlkSize [Permutation [L]]);
END;
WriteLn (Clock-Start-LoopTime:4, ' ms');
WriteLn ('MaxAvail: ', MaxAvail, ' MemAvail: ', MemAvail);
Write ('Deallocating all 1000 blocks at random: ');
Start := Clock;
FOR L := 1000 DOWNTO 1 DO BEGIN
FreeMem (BlkPtr [L], BlkSize [L]);
END;
WriteLn (Clock-Start-LoopTime:4, ' ms');
WriteLn ('MaxAvail: ', MaxAvail, ' MemAvail: ', MemAvail);
END. { HeapTest }